home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 May / PC Plus Super CD Issue 127 (May 1997).iso / delphi2 / delphite.exe / data.z / DB.INT < prev    next >
Encoding:
Text File  |  1996-08-12  |  30.0 KB  |  840 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DB;
  11.  
  12. {$N+,P+,S-,R-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Windows, Bde, Classes;
  17.  
  18. const
  19.  
  20. { TDataSet maximum number of record buffers }
  21.  
  22.   dsMaxBufferCount = 1024;
  23.  
  24. { Maximum string field size }
  25.  
  26.   dsMaxStringSize = 8192;
  27.  
  28.  { SQL Trace buffer size }
  29.  
  30.   smTraceBufSize = 8192 + SizeOf(TraceDesc);
  31.  
  32. { TDBDataSet flags }
  33.  
  34.   dbfOpened     = 0;
  35.   dbfPrepared   = 1;
  36.   dbfExecSQL    = 2;
  37.   dbfTable      = 3;
  38.   dbfFieldList  = 4;
  39.   dbfIndexList  = 5;
  40.   dbfStoredProc = 6;
  41.   dbfExecProc   = 7;
  42.   dbfProcDesc   = 8;
  43.  
  44. type
  45.  
  46. { Forward declarations }
  47.  
  48.   TDBError = class;
  49.   TSession = class;
  50.   TDatabase = class;
  51.   TFieldDefs = class;
  52.   TDataSet = class;
  53.   TDBDataSet = class;
  54.   TField = class;
  55.   TDataSource = class;
  56.   TDataLink = class;
  57.  
  58. { Generic types }
  59.  
  60.   PFieldDescList = ^TFieldDescList;
  61.   TFieldDescList = array[0..1023] of FLDDesc;
  62.  
  63.   PIndexDescList = ^TIndexDescList;
  64.   TIndexDescList = array[0..63] of IDXDesc;
  65.  
  66. { Exception classes }
  67.  
  68.   EDatabaseError = class(Exception);
  69.  
  70.   EDBEngineError = class(EDatabaseError)
  71.   public
  72.     constructor Create(ErrorCode: DBIResult);
  73.     destructor Destroy; override;
  74.     property ErrorCount: Integer;
  75.     property Errors[Index: Integer]: TDBError;
  76.   end;
  77.  
  78. { BDE error information type }
  79.  
  80.   TDBError = class
  81.   public
  82.     constructor Create(Owner: EDBEngineError; ErrorCode: DBIResult;
  83.       NativeError: Longint; Message: PChar);
  84.     property Category: Byte;
  85.     property ErrorCode: DBIResult;
  86.     property SubCode: Byte;
  87.     property Message: string;
  88.     property NativeError: Longint;
  89.   end;
  90.  
  91. { TLocale }
  92.  
  93.   TLocale = Pointer;
  94.  
  95. { TBDECallback }
  96.  
  97.   TBDECallbackEvent = function(CBInfo: Pointer): CBRType of Object;
  98.  
  99.   TBDECallback = class
  100.   protected
  101.     function Invoke(CallType: CBType; CBInfo: Pointer): CBRType;
  102.   public
  103.     constructor Create(AOwner: TObject; Handle: hDBICur; CBType: CBType;
  104.       CBBuf: Pointer; CBBufSize: Integer; CallbackEvent: TBDECallbackEvent;
  105.       Chain: Boolean);
  106.     destructor Destroy; override;
  107.   end;
  108.  
  109. { TSessionList }
  110.  
  111.   TSessionList = class(TObject)
  112.   public
  113.     constructor Create;
  114.     destructor Destroy; override;
  115.     property CurrentSession: TSession;
  116.     function FindSession(const SessionName: string): TSession;
  117.     procedure GetSessionNames(List: TStrings);
  118.     function OpenSession(const SessionName: string): TSession;
  119.     property Count: Integer;
  120.     property Sessions[Index: Integer]: TSession; default;
  121.     property List[const SessionName: string]: TSession;
  122.   end;
  123.  
  124. { TSession }
  125.  
  126.   TConfigMode = (cmPersistent, cmSession, cmAll);
  127.  
  128.   TPasswordEvent = procedure(Sender: TObject; var Continue: Boolean) of Object;
  129.  
  130.   TDatabaseEvent = (dbOpen, dbClose, dbAdd, dbRemove, dbAddAlias, dbDeleteAlias);
  131.  
  132.   TDatabaseNotifyEvent = procedure(DBEvent: TDatabaseEvent; const Param) of object;
  133.  
  134.   TBDEInitProc = procedure(Session: TSession);
  135.  
  136.   TTraceFlag = (tfQPrepare, tfQExecute, tfError, tfStmt, tfConnect,
  137.     tfTransact, tfBlob, tfMisc, tfVendor);
  138.  
  139.   TTraceFlags = set of TTraceFlag;
  140.  
  141.   TWriteProc = function (Client: TObject; Data: PChar; Len: Integer): LongBool; StdCall;
  142.   TSMRegProc = function (Handle: Integer; ClientName: PChar;
  143.     var WriteProc: TWriteProc; Instance: TObject;
  144.     const SignalProc: Pointer): TObject; StdCall;
  145.  
  146.   TSession = class(TComponent)
  147.   protected
  148.     procedure Loaded; override;
  149.     property OnDBNotify: TDatabaseNotifyEvent;
  150.     property BDEOwnsLoginCbDb: Boolean;
  151.   public
  152.     constructor Create(AOwner: TComponent); override;
  153.     destructor Destroy; override;
  154.     procedure AddAlias(const Name, Driver: string; List: TStrings);
  155.     procedure AddStandardAlias(const Name, Path, DefaultDriver: string);
  156.     property ConfigMode: TConfigMode;
  157.     procedure AddPassword(const Password: string);
  158.     procedure Close;
  159.     procedure CloseDatabase(Database: TDatabase);
  160.     procedure DeleteAlias(const Name: string);
  161.     procedure DropConnections;
  162.     function FindDatabase(const DatabaseName: string): TDatabase;
  163.     procedure GetAliasNames(List: TStrings);
  164.     procedure GetAliasParams(const AliasName: string; List: TStrings);
  165.     function GetAliasDriverName(const AliasName: string): string;
  166.     procedure GetConfigParams(const Path, Section: string; List: TStrings);
  167.     procedure GetDatabaseNames(List: TStrings);
  168.     procedure GetDriverNames(List: TStrings);
  169.     procedure GetDriverParams(const DriverName: string; List: TStrings);
  170.     function GetPassword: Boolean;
  171.     procedure GetTableNames(const DatabaseName, Pattern: string;
  172.       Extensions, SystemTables: Boolean; List: TStrings);
  173.     procedure GetStoredProcNames(const DatabaseName: string; List: TStrings);
  174.     function IsAlias(const Name: string): Boolean;
  175.     procedure ModifyAlias(Name: string; List: TStrings);
  176.     procedure Open;
  177.     function OpenDatabase(const DatabaseName: string): TDatabase;
  178.     procedure RemoveAllPasswords;
  179.     procedure RemovePassword(const Password: string);
  180.     procedure SaveConfigFile;
  181.     property DatabaseCount: Integer;
  182.     property Databases[Index: Integer]: TDatabase;
  183.     property Handle: HDBISES;
  184.     property Locale: TLocale;
  185.     property TraceFlags: TTraceFlags;
  186.   published
  187.     property Active: Boolean default False;
  188.     property KeepConnections: Boolean default True;
  189.     property NetFileDir: string;
  190.     property PrivateDir: string;
  191.     property SessionName: string;
  192.     property OnPassword: TPasswordEvent;
  193.     property OnStartup: TNotifyEvent;
  194.   end;
  195.  
  196. { TParamList }
  197.  
  198.   TParamList = class(TObject)
  199.   public
  200.     constructor Create(Params: TStrings);
  201.     destructor Destroy; override;
  202.     property Buffer: PChar;
  203.     property FieldCount: Integer;
  204.     property FieldDescs: PFieldDescList;
  205.   end;
  206.  
  207. { TDatabase }
  208.  
  209.   TTransIsolation = (tiDirtyRead, tiReadCommitted, tiRepeatableRead);
  210.  
  211.   TLoginEvent = procedure(Database: TDatabase;
  212.     LoginParams: TStrings) of object;
  213.  
  214.   TDatabase = class(TComponent)
  215.   protected
  216.     procedure Loaded; override;
  217.   public
  218.     constructor Create(AOwner: TComponent); override;
  219.     destructor Destroy; override;
  220.     procedure ApplyUpdates(const DataSets: array of TDBDataSet);
  221.     procedure Close;
  222.     procedure CloseDataSets;
  223.     procedure Commit;
  224.     procedure FlushSchemaCache(const TableName: string);
  225.     procedure Open;
  226.     procedure Rollback;
  227.     procedure StartTransaction;
  228.     procedure ValidateName(const Name: string);
  229.     property DataSetCount: Integer;
  230.     property DataSets[Index: Integer]: TDBDataSet;
  231.     property Directory: string;
  232.     property Handle: HDBIDB;
  233.     property IsSQLBased: Boolean;
  234.     property InTransaction: Boolean;
  235.     property Locale: TLocale;
  236.     property Session: TSession;
  237.     property Temporary: Boolean;
  238.     property SessionAlias: Boolean;
  239.     property TraceFlags: TTraceFlags;
  240.   published
  241.     property AliasName: string;
  242.     property Connected: Boolean default False;
  243.     property DatabaseName: string;
  244.     property DriverName: string;
  245.     property KeepConnection: Boolean default True;
  246.     property LoginPrompt: Boolean default True;
  247.     property Params: TStrings;
  248.     property SessionName: string;
  249.     property TransIsolation: TTransIsolation default tiReadCommitted;
  250.     property OnLogin: TLoginEvent;
  251.   end;
  252.  
  253. { TDataSetDesigner }
  254.  
  255.   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  256.     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  257.     deCheckBrowseMode, dePropertyChange, deFieldListChange,
  258.     deFocusControl);
  259.  
  260.   TDataSetDesigner = class(TObject)
  261.   public
  262.     constructor Create(DataSet: TDataSet);
  263.     destructor Destroy; override;
  264.     procedure BeginDesign;
  265.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  266.     procedure EndDesign;
  267.     property DataSet: TDataSet;
  268.   end;
  269.  
  270. { TFieldDef }
  271.  
  272.   TFieldClass = class of TField;
  273.  
  274.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  275.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  276.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  277.     ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary);
  278.  
  279.   TFieldDef = class
  280.   public
  281.     constructor Create(Owner: TFieldDefs; const Name: string;
  282.       DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  283.     destructor Destroy; override;
  284.     function CreateField(Owner: TComponent): TField;
  285.     property BDECalcField: Boolean;
  286.     property DataType: TFieldType;
  287.     property FieldClass: TFieldClass;
  288.     property FieldNo: Integer;
  289.     property Name: string;
  290.     property Required: Boolean;
  291.     property Size: Word;
  292.   end;
  293.  
  294. { TFieldDefs }
  295.  
  296.   TFieldDefs = class
  297.   public
  298.     constructor Create(DataSet: TDataSet);
  299.     destructor Destroy; override;
  300.     procedure Add(const Name: string; DataType: TFieldType; Size: Word;
  301.       Required: Boolean);
  302.     procedure AddFieldDesc(FieldDesc: FLDDesc; Required: Boolean;
  303.       FieldNo: Word);
  304.     procedure Assign(FieldDefs: TFieldDefs);
  305.     procedure Clear;
  306.     function Find(const Name: string): TFieldDef;
  307.     function IndexOf(const Name: string): Integer;
  308.     procedure Update;
  309.     property Count: Integer;
  310.     property Items[Index: Integer]: TFieldDef; default;
  311.   end;
  312.  
  313. { TDataSet }
  314.  
  315.   TBookmark = Pointer;
  316.   TBookmarkStr = String;
  317.  
  318.   PBufferList = ^TBufferList;
  319.   TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  320.  
  321.   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert,
  322.     dsSetKey, dsCalcFields, dsUpdateNew, dsUpdateOld, dsFilter);
  323.  
  324.   TGetMode = (gmCurrent, gmNext, gmPrior);
  325.  
  326.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  327.   TFilterOptions = set of TFilterOption;
  328.  
  329.   TLocateOption = (loCaseInsensitive, loPartialKey);
  330.   TLocateOptions = set of TLocateOption;
  331.  
  332.   TResyncMode = set of (rmExact, rmCenter);
  333.  
  334.   TKeyIndex = (kiLookup, kiRangeStart, kiRangeEnd, kiCurRangeStart,
  335.     kiCurRangeEnd, kiSave);
  336.  
  337.   PKeyBuffer = ^TKeyBuffer;
  338.   TKeyBuffer = record
  339.     Modified: Boolean;
  340.     Exclusive: Boolean;
  341.     FieldCount: Integer;
  342.     Data: record end;
  343.   end;
  344.  
  345.   TDataAction = (daFail, daAbort, daRetry);
  346.  
  347.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  348.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  349.     var Action: TDataAction) of object;
  350.  
  351.  
  352.   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  353.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  354.   TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  355.   TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  356.   TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  357.     UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  358.   TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
  359.     var UpdateAction: TUpdateAction) of object;
  360.   TOnServerYieldEvent = procedure(DataSet: TDataSet; var AbortQuery: Boolean) of object;
  361.   TDataSetUpdateObject = class(TComponent)
  362.   protected
  363.     function GetDataSet: TDataSet; virtual; abstract;
  364.     procedure SetDataSet(ADataSet: TDataSet); virtual; abstract;
  365.     procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
  366.     property DataSet: TDataSet;
  367.   end;
  368.  
  369.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  370.     var Accept: Boolean) of object;
  371.  
  372.   TRecNoStatus = (rnDbase, rnParadox, rnNotSupported);
  373.  
  374.   PRecInfo = ^TRecInfo;
  375.   TRecInfo = record
  376.     UpdateStatus: TUpdateStatus;
  377.     RecordNumber: Longint;
  378.   end;
  379.  
  380.   TDataOperation = function: DBIResult of object;
  381.  
  382.   TDataSet = class(TComponent)
  383.     procedure BeginInsertAppend;
  384.     procedure BindFields(Binding: Boolean);
  385.     function CachedUpdateCallBack(CBInfo: Pointer): CBRType;
  386.     procedure CalculateBDEFields;
  387.     procedure CalculateFields;
  388.     procedure CheckCanModify;
  389.     procedure CheckCachedUpdateMode;
  390.     procedure CheckFieldName(const FieldName: string);
  391.     procedure CheckFieldNames(const FieldNames: string);
  392.     procedure CheckOperation(Operation: TDataOperation;
  393.       ErrorEvent: TDataSetErrorEvent);
  394.     procedure CheckRequiredFields;
  395.     procedure CheckSetKeyMode;
  396.     procedure CopyBuffer(SourceIndex, DestIndex: Integer);
  397.     function CreateExprFilter(const Expr: string;
  398.       Options: TFilterOptions; Priority: Integer): HDBIFilter;
  399.     procedure CreateFields;
  400.     function CreateFuncFilter(FilterFunc: Pointer;
  401.       Priority: Integer): HDBIFilter;
  402.     function CreateLookupFilter(Fields: TList; const Values: Variant;
  403.       Options: TLocateOptions; Priority: Integer): HDBIFilter;
  404.     procedure DeactivateFilters;
  405.     function DeleteRecord: DBIResult;
  406.     procedure DestroyFields;
  407.     function EditRecord: DBIResult;
  408.     procedure EndInsertAppend;
  409.     function FieldByNumber(FieldNo: Integer): TField;
  410.     function FindRecord(Restart, GoForward: Boolean): Boolean;
  411.     procedure FreeFieldBuffers;
  412.     procedure FreeKeyBuffers;
  413.     function GetActive: Boolean;
  414.     function GetBookmarkStr: TBookmarkStr;
  415.     procedure GetCalcFields(Index: Integer);
  416.     function GetField(Index: Integer): TField;
  417.     function GetFieldCount: Integer;
  418.     function GetFieldValue(const FieldName: string): Variant;
  419.     procedure GetIndexInfo;
  420.     function GetNextRecord: Boolean;
  421.     function GetNextRecords: Integer;
  422.     function GetPriorRecord: Boolean;
  423.     function GetPriorRecords: Integer;
  424.     function GetRecord(Index: Integer; GetMode: TGetMode): DBIResult;
  425.     function GetRecordCount: Longint;
  426.     function GetUpdatesPending: Boolean;
  427.     function InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  428.     procedure InitRecord(Buffer: PChar);
  429.     procedure InternalClose;
  430.     procedure InternalOpen;
  431.     function LocateRecord(const KeyFields: string; const KeyValues: Variant;
  432.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  433.     function MapsToIndex(Fields: TList; CaseInsensitive: Boolean): Boolean;
  434.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  435.     procedure PostKeyBuffer(Commit: Boolean);
  436.     function PostRecord: DBIResult;
  437.     function RecordFilter(RecBuf: Pointer; RecNo: Integer): Smallint; stdcall;
  438.     procedure RemoveDataSource(DataSource: TDataSource);
  439.     procedure RemoveField(Field: TField);
  440.     procedure SetActive(Value: Boolean);
  441.     procedure SetBookmarkStr(const Value: TBookmarkStr);
  442.     procedure SetBufferCount(Value: Integer);
  443.     procedure SetBufListSize(Value: Integer);
  444.     procedure SetCurrentRecord(Index: Integer);
  445.     procedure SetField(Index: Integer; Value: TField);
  446.     procedure SetFieldDefs(Value: TFieldDefs);
  447.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  448.     procedure SetFilterData(const Text: string; Options: TFilterOptions);
  449.     procedure SetFiltered(Value: Boolean);
  450.     procedure SetFilterHandle(var Filter: HDBIFilter; Value: HDBIFilter);
  451.     procedure SetFilterOptions(Value: TFilterOptions);
  452.     procedure SetFilterText(const Value: string);
  453.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent);
  454.     procedure SetOnUpdateError(UpdateEvent: TUpdateErrorEvent);
  455.     procedure SetState(Value: TDataSetState);
  456.     procedure UpdateBufferCount;
  457.     function UpdateCallbackRequired: Boolean;
  458.     procedure UpdateFieldDefs;
  459.     function YieldCallBack(CBInfo: Pointer): CBRType;
  460.   protected
  461.     procedure CheckInactive;
  462.     procedure ClearBuffers;
  463.     procedure CloseCursor; virtual;
  464.     function CreateHandle: HDBICur; virtual;
  465.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  466.     procedure DestroyHandle; virtual;
  467.     procedure DestroyLookupCursor; virtual;
  468.     procedure DoAfterCancel; virtual;
  469.     procedure DoAfterClose; virtual;
  470.     procedure DoAfterDelete; virtual;
  471.     procedure DoAfterEdit; virtual;
  472.     procedure DoAfterInsert; virtual;
  473.     procedure DoAfterOpen; virtual;
  474.     procedure DoAfterPost; virtual;
  475.     procedure DoBeforeCancel; virtual;
  476.     procedure DoBeforeClose; virtual;
  477.     procedure DoBeforeDelete; virtual;
  478.     procedure DoBeforeEdit; virtual;
  479.     procedure DoBeforeInsert; virtual;
  480.     procedure DoBeforeOpen; virtual;
  481.     procedure DoBeforePost; virtual;
  482.     procedure DoOnCalcFields; virtual;
  483.     procedure DoOnNewRecord; virtual;
  484.     function GetCanModify: Boolean; virtual;
  485.     function GetDataSource: TDataSource; virtual;
  486.     function GetIndexField(Index: Integer): TField;
  487.     function GetIndexFieldCount: Integer;
  488.     function GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  489.     function GetKeyExclusive: Boolean;
  490.     function GetKeyFieldCount: Integer;
  491.     function GetLookupCursor(const KeyFields: string;
  492.       CaseInsensitive: Boolean): HDBICur; virtual;
  493.     function GetRecordNumber: Longint; virtual;
  494.     procedure InitFieldDefs; virtual;
  495.     procedure Loaded; override;
  496.     procedure OpenCursor; virtual;
  497.     procedure PrepareCursor; virtual;
  498.     function ResetCursorRange: Boolean;
  499.     function SetCursorRange: Boolean;
  500.     procedure SetIndexField(Index: Integer; Value: TField);
  501.     procedure SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  502.     procedure SetKeyExclusive(Value: Boolean);
  503.     procedure SetKeyFieldCount(Value: Integer);
  504.     procedure SetKeyFields(KeyIndex: TKeyIndex; const Values: array of const);
  505.     procedure SetLinkRanges(MasterFields: TList);
  506.     procedure SetLocale(Value: TLocale);
  507.     procedure SetName(const Value: TComponentName); override;
  508.     procedure SwitchToIndex(const IndexName, TagName: string);
  509.     procedure GetChildren(Proc: TGetChildProc); override;
  510.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  511.     property InfoQueryMode: Boolean;
  512.     procedure SetCachedUpdates(Value: Boolean);
  513.     procedure SetupCallBack(Value: Boolean);
  514.     function ProcessUpdates(UpdCmd: DBIDelayedUpdCmd): DBIResult;
  515.     function GetUpdateRecordSet: TUpdateRecordTypes;
  516.     procedure SetUpdateRecordSet(RecordTypes: TUpdateRecordTypes);
  517.     procedure SetUpdateObject(Value: TDataSetUpdateObject);
  518.     function ForceUpdateCallback: Boolean;
  519.   public
  520.     constructor Create(AOwner: TComponent); override;
  521.     destructor Destroy; override;
  522.     function ActiveBuffer: PChar;
  523.     procedure Append;
  524.     procedure AppendRecord(const Values: array of const);
  525.     procedure Cancel;
  526.     procedure CheckBrowseMode;
  527.     procedure ClearFields;
  528.     procedure Close;
  529.     function  ControlsDisabled: Boolean;
  530.     procedure CursorPosChanged;
  531.     procedure Delete;
  532.     procedure DisableControls;
  533.     procedure Edit;
  534.     procedure EnableControls;
  535.     procedure FetchAll;
  536.     function FieldByName(const FieldName: string): TField;
  537.     function FindField(const FieldName: string): TField;
  538.     function FindFirst: Boolean;
  539.     function FindLast: Boolean;
  540.     function FindNext: Boolean;
  541.     function FindPrior: Boolean;
  542.     procedure First;
  543.     procedure FreeBookmark(Bookmark: TBookmark);
  544.     function GetBookmark: TBookmark;
  545.     function GetCurrentRecord(Buffer: PChar): Boolean;
  546.     procedure GetFieldList(List: TList; const FieldNames: string);
  547.     procedure GetFieldNames(List: TStrings);
  548.     procedure GotoBookmark(Bookmark: TBookmark);
  549.     procedure Insert;
  550.     procedure InsertRecord(const Values: array of const);
  551.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  552.     procedure Last;
  553.     function Locate(const KeyFields: string; const KeyValues: Variant;
  554.       Options: TLocateOptions): Boolean;
  555.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  556.       const ResultFields: string): Variant;
  557.     function MoveBy(Distance: Integer): Integer;
  558.     procedure Next;
  559.     procedure Open;
  560.     procedure Post;
  561.     procedure Prior;
  562.     procedure Refresh;
  563.     procedure Resync(Mode: TResyncMode);
  564.     procedure SetFields(const Values: array of const);
  565.     procedure SetDetailFields(MasterFields: TList);
  566.     procedure UpdateCursorPos;
  567.     procedure UpdateRecord;
  568.     procedure ApplyUpdates;
  569.     procedure CommitUpdates;
  570.     procedure CancelUpdates;
  571.     procedure RevertRecord;
  572.     function UpdateStatus: TUpdateStatus;
  573.     property BOF: Boolean;
  574.     property Bookmark: TBookmarkStr;
  575.     property CanModify: Boolean;
  576.     property DataSource: TDataSource;
  577.     property DefaultFields: Boolean;
  578.     property Designer: TDataSetDesigner;
  579.     property EOF: Boolean;
  580.     property ExpIndex: Boolean;
  581.     property FieldCount: Integer;
  582.     property FieldDefs: TFieldDefs;
  583.     property Fields[Index: Integer]: TField;
  584.     property FieldValues[const FieldName: string]: Variant; default;
  585.     property Found: Boolean;
  586.     property Handle: HDBICur;
  587.     property KeySize: Word;
  588.     property Locale: TLocale;
  589.     property Modified: Boolean;
  590.     property RecordCount: Longint;
  591.     property RecNo: Longint;
  592.     property RecordSize: Word;
  593.     property State: TDataSetState;
  594.     property UpdateObject: TDataSetUpdateObject;
  595.     property UpdateRecordTypes: TUpdateRecordTypes;
  596.     property UpdatesPending: Boolean;
  597.   published
  598.     property Active: Boolean default False;
  599.     property AutoCalcFields: Boolean default True;
  600.     property CachedUpdates: Boolean default False;
  601.     property Filter: string;
  602.     property Filtered: Boolean default False;
  603.     property FilterOptions: TFilterOptions default [];
  604.     property BeforeOpen: TDataSetNotifyEvent;
  605.     property AfterOpen: TDataSetNotifyEvent;
  606.     property BeforeClose: TDataSetNotifyEvent;
  607.     property AfterClose: TDataSetNotifyEvent;
  608.     property BeforeInsert: TDataSetNotifyEvent;
  609.     property AfterInsert: TDataSetNotifyEvent;
  610.     property BeforeEdit: TDataSetNotifyEvent;
  611.     property AfterEdit: TDataSetNotifyEvent;
  612.     property BeforePost: TDataSetNotifyEvent;
  613.     property AfterPost: TDataSetNotifyEvent;
  614.     property BeforeCancel: TDataSetNotifyEvent;
  615.     property AfterCancel: TDataSetNotifyEvent;
  616.     property BeforeDelete: TDataSetNotifyEvent;
  617.     property AfterDelete: TDataSetNotifyEvent;
  618.     property OnNewRecord: TDataSetNotifyEvent;
  619.     property OnCalcFields: TDataSetNotifyEvent;
  620.     property OnFilterRecord: TFilterRecordEvent;
  621.     property OnServerYield: TOnServerYieldEvent;
  622.     property OnUpdateError: TUpdateErrorEvent;
  623.     property OnUpdateRecord: TUpdateRecordEvent;
  624.     property OnEditError: TDataSetErrorEvent;
  625.     property OnPostError: TDataSetErrorEvent;
  626.     property OnDeleteError: TDataSetErrorEvent;
  627.   end;
  628.  
  629. { TDBDataSet }
  630.  
  631.   TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  632.   TDBFlags = set of 0..15;
  633.  
  634.   TDBDataSet = class(TDataSet)
  635.   protected
  636.     procedure CloseCursor; override;
  637.     procedure Disconnect; virtual;
  638.     procedure OpenCursor; override;
  639.     procedure SetDBFlag(Flag: Integer; Value: Boolean); virtual;
  640.     property DBFlags: TDBFlags;
  641.     property UpdateMode: TUpdateMode default upWhereAll;
  642.   public
  643.     function CheckOpen(Status: DBIResult): Boolean;
  644.     property Database: TDatabase;
  645.     property DBHandle: HDBIDB;
  646.     property DBLocale: TLocale;
  647.     property DBSession: TSession;
  648.   published
  649.     property DatabaseName: string;
  650.     property SessionName: string;
  651.   end;
  652.  
  653. { TDataSource }
  654.  
  655.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  656.  
  657.   TDataSource = class(TComponent)
  658.   public
  659.     constructor Create(AOwner: TComponent); override;
  660.     destructor Destroy; override;
  661.     procedure Edit;
  662.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  663.     property State: TDataSetState;
  664.   published
  665.     property AutoEdit: Boolean default True;
  666.     property DataSet: TDataSet;
  667.     property Enabled: Boolean default True;
  668.     property OnStateChange: TNotifyEvent;
  669.     property OnDataChange: TDataChangeEvent;
  670.     property OnUpdateData: TNotifyEvent;
  671.   end;
  672.  
  673. { TField }
  674.  
  675.   TFieldKind = (fkData, fkCalculated, fkLookup);
  676.  
  677.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  678.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  679.     DisplayText: Boolean) of object;
  680.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  681.   TFieldRef = ^TField;
  682.  
  683.   TField = class(TComponent)
  684.   protected
  685.     procedure AccessError(const TypeName: string);
  686.     procedure CheckInactive;
  687.     procedure Change; virtual;
  688.     procedure DataChanged;
  689.     procedure DefineProperties(Filer: TFiler); override;
  690.     procedure FreeBuffers; virtual;
  691.     function GetAsBoolean: Boolean; virtual;
  692.     function GetAsCurrency: Currency; virtual;
  693.     function GetAsDateTime: TDateTime; virtual;
  694.     function GetAsFloat: Double; virtual;
  695.     function GetAsInteger: Longint; virtual;
  696.     function GetAsString: string; virtual;
  697.     function GetAsVariant: Variant; virtual;
  698.     function GetCanModify: Boolean;
  699.     function GetDefaultWidth: Integer; virtual;
  700.     function GetParentComponent: TComponent; override;
  701.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  702.     function HasParent: Boolean; override;
  703.     procedure Notification(AComponent: TComponent;
  704.       Operation: TOperation); override;
  705.     procedure PropertyChanged(LayoutAffected: Boolean);
  706.     procedure ReadState(Reader: TReader); override;
  707.     procedure SetAsBoolean(Value: Boolean); virtual;
  708.     procedure SetAsCurrency(Value: Currency); virtual;
  709.     procedure SetAsDateTime(Value: TDateTime); virtual;
  710.     procedure SetAsFloat(Value: Double); virtual;
  711.     procedure SetAsInteger(Value: Longint); virtual;
  712.     procedure SetAsString(const Value: string); virtual;
  713.     procedure SetAsVariant(const Value: Variant); virtual;
  714.     procedure SetDataType(Value: TFieldType);
  715.     procedure SetSize(Value: Word);
  716.     procedure SetParentComponent(AParent: TComponent); override;
  717.     procedure SetText(const Value: string); virtual;
  718.     procedure SetVarValue(const Value: Variant); virtual;
  719.   public
  720.     constructor Create(AOwner: TComponent); override;
  721.     destructor Destroy; override;
  722.     procedure Assign(Source: TPersistent); override;
  723.     procedure AssignValue(const Value: TVarRec);
  724.     procedure Clear; virtual;
  725.     procedure FocusControl;
  726.     function GetData(Buffer: Pointer): Boolean;
  727.     function IsValidChar(InputChar: Char): Boolean; virtual;
  728.     procedure SetData(Buffer: Pointer);
  729.     procedure SetFieldType(Value: TFieldType); virtual;
  730.     property AsBoolean: Boolean;
  731.     property AsCurrency: Currency;
  732.     property AsDateTime: TDateTime;
  733.     property AsFloat: Double;
  734.     property AsInteger: Longint;
  735.     property AsString: string;
  736.     property AsVariant: Variant;
  737.     property AttributeSet: string;
  738.     property BDECalcField: Boolean;
  739.     property CanModify: Boolean;
  740.     property DataSet: TDataSet;
  741.     property DataSize: Word;
  742.     property DataType: TFieldType;
  743.     property DisplayName: string;
  744.     property DisplayText: string;
  745.     property EditMask: string;
  746.     property EditMaskPtr: string;
  747.     property FieldKind: TFieldKind;
  748.     property FieldNo: Integer;
  749.     property IsIndexField: Boolean;
  750.     property IsNull: Boolean;
  751.     property Size: Word;
  752.     property Text: string;
  753.     property Value: Variant;
  754.     property NewValue: Variant;
  755.     property OldValue: Variant;
  756.   published
  757.     property Alignment: TAlignment default taLeftJustify;
  758.     property Calculated: Boolean default False;
  759.     property DisplayLabel: string;
  760.     property DisplayWidth: Integer;
  761.     property FieldName: string;
  762.     property Index: Integer;
  763.     property Lookup: Boolean default False;
  764.     property LookupDataSet: TDataSet;
  765.     property LookupKeyFields: string;
  766.     property LookupResultField: string;
  767.     property KeyFields: string;
  768.     property ReadOnly: Boolean default False;
  769.     property Required: Boolean default False;
  770.     property Visible: Boolean default True;
  771.     property OnChange: TFieldNotifyEvent;
  772.     property OnGetText: TFieldGetTextEvent;
  773.     property OnSetText: TFieldSetTextEvent;
  774.     property OnValidate: TFieldNotifyEvent;
  775.   end;
  776.  
  777. { TDataLink }
  778.  
  779.   TDataLink = class(TPersistent)
  780.   protected
  781.     procedure ActiveChanged; virtual;
  782.     procedure CheckBrowseMode; virtual;
  783.     procedure DataSetChanged; virtual;
  784.     procedure DataSetScrolled(Distance: Integer); virtual;
  785.     procedure FocusControl(Field: TFieldRef); virtual;
  786.     procedure EditingChanged; virtual;
  787.     procedure LayoutChanged; virtual;
  788.     procedure RecordChanged(Field: TField); virtual;
  789.     procedure UpdateData; virtual;
  790.   public
  791.     constructor Create;
  792.     destructor Destroy; override;
  793.     function Edit: Boolean;
  794.     procedure UpdateRecord;
  795.     property Active: Boolean;
  796.     property ActiveRecord: Integer;
  797.     property BufferCount: Integer;
  798.     property DataSet: TDataSet;
  799.     property DataSource: TDataSource;
  800.     property DataSourceFixed: Boolean;
  801.     property Editing: Boolean;
  802.     property ReadOnly: Boolean;
  803.     property RecordCount: Integer;
  804.   end;
  805.  
  806. const
  807.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  808.  
  809. function AnsiToNative(Locale: TLocale; const AnsiStr: string;
  810.   NativeStr: PChar; MaxLen: Integer): PChar;
  811. procedure NativeToAnsi(Locale: TLocale; NativeStr: PChar;
  812.   var AnsiStr: string);
  813. procedure AnsiToNativeBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  814. procedure NativeToAnsiBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  815.  
  816. function NativeCompareStr(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  817. function NativeCompareStrBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  818. function NativeCompareText(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  819. function NativeCompareTextBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  820.  
  821. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  822.  
  823. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  824.  
  825. procedure DatabaseError(const Message: string);
  826. procedure DBError(Ident: Word);
  827. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  828. procedure DbiError(ErrorCode: DBIResult);
  829. procedure Check(Status: DBIResult);
  830. procedure RegisterBDEInitProc(const InitProc: TBDEInitProc);
  831.  
  832. var
  833.   Session: TSession;
  834.   Sessions: TSessionList;
  835.  
  836. const
  837.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  838.  
  839. implementation
  840.